home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / SysGen / fromfile < prev    next >
Encoding:
Text File  |  1992-01-26  |  3.4 KB  |  123 lines
  1. \ file? NAME ... prints file that NAME was compiled from...
  2. \
  3. \ NOTE: this only is true if FILEHEADERS was true at compile time...
  4. \       This is the normal default state for JForth.
  5. \ 00001 26-jan-92 mdh  CR chganged to >NEWLINE
  6. include? valid-name? jf:smart-id.
  7.  
  8. decimal
  9.  
  10. \ : @?   ( addr -- )  dup 1 and
  11. \   IF   cr ." long fetch, odd boundary: "  base @ hex swap . base !  quit
  12. \   THEN @ ;
  13. \ 
  14. \ : @ @? ;
  15.  
  16. ' forth >name  ' root - constant vocsize
  17.  
  18. : fileheader?  ( nfa -- flag )
  19.   1+ odd@  $ 3a3a3a3a =
  20. ;
  21.  
  22. : unnest  ( -- nfa )
  23.   BEGIN  n>link @   ( prevnfa -- )
  24.          dup fileheader?
  25.   UNTIL  ;
  26.  
  27. : nested?   ( nfa -- true-if-;;; )
  28.   @  $ 833b3b3b =   ;
  29.  
  30.  
  31. : lookforit   ( addr cnt -- , of filename text )
  32.   here pad 128 + $move
  33.   >dos  dosstring 2+  (fopen) -dup       ( wants null-term )
  34.   IF    dup  markfclose  tempfile !
  35.         tempbuff openfv markfreeblock    ( -- )
  36.         BEGIN  2 x>r  ?pause  2 xr>
  37.                tempfile @  tempbuff  pad 128 readline    
  38.                ( pad actual-line-len ) dup  0< 0=
  39.         WHILE  ( not end of file ) ( pad actual-line-len ) dup
  40.                IF  ( not an empty line )   ( pad len -- )
  41.                    2dup pad 128 + count match?  ( pad len flag -- )
  42.                    IF   ( found it there! ) cr
  43.                         BEGIN  type  2 x>r  ?pause 2 xr>   cr  ( -- )
  44.                                tempfile @ tempbuff
  45.                                pad 128 readline dup 0= over 0< or
  46.                         UNTIL  ( adr cnt -- )
  47.                    THEN
  48.                THEN 2drop
  49.         REPEAT 2drop
  50.         tempbuff @ unmarkfreeblock
  51.         tempbuff closefvread
  52.         tempfile @ dup unmarkfclose  fclose
  53.   ELSE  cr ." Sorry, can't open the file."
  54.   THEN  ;
  55.  
  56. user #nested
  57.  
  58. : nextname?   ( nfa -- next-nfa OR 0 )  dup 0> >r
  59.   BEGIN  2- dup r@
  60.          IF
  61.             0>
  62.          ELSE
  63.             >abs
  64.          THEN
  65.          IF   dup valid-name?
  66.          ELSE drop false true
  67.          THEN
  68.   UNTIL  rdrop  ;
  69.  
  70.  
  71. : NFA.FILE? ( nfa -- , file? with this NFA )
  72.        1 #nested !
  73.        >newline dup id. 
  74.        BEGIN  dup nextname? ( thisnfa prevnfa/0 -- ) -dup
  75.               IF   swap drop dup nested?
  76.                    IF    1 #nested +!
  77.                    THEN
  78.                    dup fileheader?  dup
  79.                    IF   -1  #nested +!
  80.                    THEN #nested @ 0= and
  81.               ELSE cr ." FILE?: fileheaders not found!" quit
  82.               THEN
  83.        UNTIL
  84.        ."  was compiled from "  dup >r
  85.        ( nfa -- )  dup c@ $ 1f and    ( nfa cnt -- )
  86.        4 -  ( nfa cnt-4 -- ) ( adjust out the locater text )
  87.        swap 5 + swap  ( adr cnt -- , of filename )
  88.        2dup type  cr   r> [ ' ::::keyboard >name ] literal = 0=
  89.        IF   ." Display?" y/n
  90.             IF   2dup lookforit
  91.             THEN
  92.        THEN 2drop
  93. ;
  94. \
  95. : file?   ( -- )   ( eats: name )
  96.   >newline bl word  find  cr
  97.   IF   ( pfa -- )  >name ( -- nfa)
  98.       nfa.file?
  99.   ELSE $type ."  isn't in the selected vocabularies."
  100.   THEN  cr ;
  101.  
  102. \ : view   ( -- , eats filename from input )
  103. \   file?  ;
  104.  
  105.  
  106. : MATCH.FILE? ( nfa -- , file? if match )
  107.     dup count $ 1F and ( -- nfa addr count )
  108.     here count 2 pick = ( nfa addr count here )
  109.     IF  text=? ( -- nfa flag )
  110.         IF nfa.file? cr
  111.         ELSE drop
  112.         THEN
  113.     ELSE 2drop 2drop
  114.     THEN
  115. ;
  116.  
  117. : EACH.FILE?  ( <name> -- , file? for every entry in dict. )
  118.     bl word drop
  119.     ' match.file? is when-scanned
  120.     ' drop is when-voc-scanned
  121.     scan-all-vocs
  122. ;
  123.